home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
out18com.zip
/
LOCFILE.INC
< prev
next >
Wrap
Text File
|
1993-01-04
|
2KB
|
113 lines
const locfile_tag: string[90]
= #0'@(#)CURRENT_FILE LAST_UPDATE Locate file with PATH 1.1'#0;
#log Locate file with PATH 1.1
(*
* get the value of an environment variable
*
*)
type
gestring = string[255];
function get_environment_var(id: gestring): gestring;
var
envseg: integer absolute cseg:$2c;
i: integer;
env: gestring;
begin
i := 0;
repeat
env := '';
while mem[envseg:i] <> 0 do
begin
env := env + chr(mem[envseg:i]);
i := i + 1;
end;
if copy(env,1,length(id)) = id then
begin
get_environment_var := copy(env,length(id)+1,255);
exit;
end;
i := i + 1;
until mem[envseg:i] = 0;
(* not found *)
get_environment_var := '';
end;
(*
* locate a file with search rules from specified environment variable.
* returns the full pathname of the located file.
* returns only the original name if not found.
*
*)
function locate_file_env(name: gestring;
environ: gestring): gestring;
var
paths: gestring;
dir: gestring;
i: integer;
fd: file;
begin
(* get the paths and start searching them. arrange for current directory
to be scanned first. add trailing ; to handle special case for last path *)
paths := ';' + get_environment_var(environ) + ';';
dir := '';
for i := 1 to length(paths) do
begin
(* if a full directory has been collected, then try this path *)
if (paths[i] = ';') or (i = length(paths)) then
begin
if (length(dir) > 1) and (dir[length(dir)] <> '\') then
dir := dir + '\';
{$I-}
assign(fd,dir + name);
reset(fd);
{$I+}
if ioresult = 0 then
begin
close(fd);
locate_file_env := dir + name;
exit;
end;
dir := '';
end
else
dir := dir + paths[i];
end;
(* couldn't find it. return the original name *)
locate_file_env := name;
end;
(*
* locate a file. search PATH= paths if needed. returns
* the full pathname of the located file.
* returns only the original name if not found.
*
*)
function locate_file(name: gestring): gestring;
begin
locate_file := locate_file_env(name,'PATH=');
end;